home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Delphi Programmer's Power Pack
/
Delphi Volume 1.iso
/
s_to_z
/
smtpmail
/
mime.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1996-09-15
|
4KB
|
185 lines
unit Mime;
interface
uses Classes,SysUtils,Forms,Dialogs;
const
MaxChars = 57;
type
TBinBytes = array[1..MaxChars] of byte;
TTxtBytes = array[1..2*MaxChars] of byte;
TBuffer = array[1..$FFF0] of byte;
T24Bits = array[0..8*MaxChars] of boolean;
EUUInvalidCharacter = class(Exception)
constructor Create;
end;
TMIME = class
private
StringList : TStringList;
Stream : TStream;
CurSection : byte;
A24Bits : T24Bits;
FOnProgress : TNotifyEvent;
FOnStart : TNotifyEvent;
FOnEnd : TNotifyEvent;
function GenerateTxtBytes(tb : TBinBytes; NumOfBytes : byte) : string;
procedure DoProgress(Sender : TObject);
procedure DoStart(Sender : TObject);
procedure DoEnd(Sender : TObject);
public
Progress : Integer;
ProgressStep : Integer;
Canceled : boolean;
Table : string;
constructor Create(AStream : TStream; AStringList : TStringList);
procedure Encode;
property OnProgress : TNotifyEvent read FOnProgress
write FOnProgress;
property OnStart : TNotifyEvent read FOnStart write FOnStart;
property OnEnd : TNotifyEvent read FOnEnd write FOnEnd;
end;
function GetContentType(const FileName : string) : string;
function MakeUniqueID : string;
implementation
constructor EUUInvalidCharacter.Create;
begin
inherited Create('Invalid character in the input file');
end;
{TMIME}
constructor TMIME.Create(AStream : TStream; AStringList : TStringList);
begin
inherited Create;
Stream:=AStream;
StringList:=AStringList;
ProgressStep:=10;
Table:='ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
FillChar(A24Bits,SizeOf(A24Bits),0);
end;
procedure TMIME.DoProgress(Sender : TObject);
begin
if Assigned(FOnProgress) then
FOnProgress(Sender);
end;
procedure TMIME.DoStart(Sender : TObject);
begin
if Assigned(FOnStart) then
FOnStart(Sender);
end;
procedure TMIME.DoEnd(Sender : TObject);
begin
if Assigned(FOnEnd) then
FOnEnd(Sender);
end;
function TMIME.GenerateTxtBytes(tb : TBinBytes; NumOfBytes : byte) : string;
var
i,j,k,b,m : word;
CheckSum : word;
s : string;
begin
k:=0;
FillChar(A24Bits,SizeOf(T24Bits),0);
for i:=1 to MaxChars do
begin
b:=tb[i];
for j:=7 DownTo 0 do
begin
m:=1 shl j;
if (b and m = m) then
A24Bits[k]:=true;
Inc(k);
end;
end;
s:=''; k:=0; m:=4*(MaxChars div 3);
CheckSum:=0;
for i:=1 to m do
begin
b:=0;
for j:=5 DownTo 0 do
begin
if A24Bits[k] then b:= b or (1 shl j);
Inc(k);
end;
s[i]:=Table[b+1];
end;
if (NumOfBytes=MaxChars) or (NumOfBytes mod 3=0) then
s[0]:=Char(4*NumOfBytes div 3)
else
begin
s[0]:=Char(4*NumOfBytes div 3+1);
while (Length(s) mod 4)<>0 do
s:=Concat(s,'=');
end;
Result:=s;
end;
procedure TMIME.Encode;
var
BytesRead : word;
ABinBytes : TBinBytes;
Total : LongInt;
begin
DoStart(Self);
StringList.Clear;
Progress:=0; Total:=0; Canceled:=false;
try
repeat
FillChar(ABinBytes,SizeOf(TBinBytes),0);
BytesRead:=Stream.Read(ABinBytes,MaxChars);
Inc(Total,BytesRead);
StringList.Add(GenerateTxtBytes(ABinBytes,BytesRead));
Progress:=100*Total div Stream.Size;
if Progress mod ProgressStep = 0 then
DoProgress(Self);
Application.ProcessMessages;
until (BytesRead<MaxChars) or Canceled;
finally
Progress:=100;
DoProgress(Self);
if Canceled then StringList.Clear;
DoEnd(Self);
end;
end;
function GetContentType(const FileName : string) : string;
var
Ext : string[4];
begin
Ext:=UpperCase(ExtractFileExt(FileName));
if Ext='.AIF' then result:='audio/aiff'
else
if (Ext='.AU') or (Ext='.SND') then result:='audio/basic'
else
if Ext='.GIF' then result:='image/gif'
else
if Ext='.JPG' then result:='image/jpeg'
else
if Ext='.AVI' then result:='video/avi'
else
result:='application/octet-stream';
end;
function MakeUniqueID : string;
var
i : Integer;
begin
Randomize;
Result:='';
for i:=1 to 8 do
Result:=Concat(Result,IntToStr(Random(9)));
end;
end.